home *** CD-ROM | disk | FTP | other *** search
/ MacHack 1994 / MacHack 1994.toast / MacHack™94 / Talks & Papers / Timothy Knox / yerk 3.66 / System source / Mod < prev    next >
Text File  |  1994-06-24  |  7KB  |  171 lines
  1. \ Module - support for separately compiled modules in Yerk
  2. \ 12/04/84  CBD Version 1
  3. \ 10/22/85  cdn Echo during module load
  4. \ 12/20/85  cdn Reuse target BIN file- so as not to wrestle file from folder
  5. \  7/11/86  cdn Modify flagging technique in BldBits for faster run time
  6. \  7/26/86  cdn Added ^last word defined in module as first 4 bytes
  7. \  8/31/88    rfl ***WARNING***
  8. \                The code to become a module must clear all data areas it uses.
  9. \                If it doesn't, the second pass will have differing bytes
  10. \                than the first pass and bldbits will think they are
  11. \                relocatable addresses!
  12. \ 5/06/93    rfl added 'immediates' to handle marking immediate imports
  13. \ 6/04/93    rfl    sfind now doesn't map to uppercase, as advertised in glossary
  14. \                screate modified for source documentation...screate and sfine
  15. \                moved to 'file' ... 'module' saves doc state and sets to -doc
  16. \ 1/01/94    rfl    change set-file to setNamePtr: topfile
  17. \ 1/05/94    rfl dispose of old module for module compile changed to keep
  18. \                  old install bit.
  19. Decimal
  20.  
  21. \ use: You must define the imports for a module in the resident
  22. \ portion of your application with the statement:
  23. \     FROM moduleName IMPORT{ imp0 ... impN }
  24. \ This will create a module definition for filename "moduleName"
  25. \ and import definitions for all imported names.
  26. \ Later, you must build the module with the statement
  27. \    module "moduleName"
  28. \ This will look up the mod def for moduleName, and generate a
  29. \ relocatable module from its source file.
  30. \ After the module is built, any reference to one of the imported names
  31. \ will cause the module to be loaded. Imported names are local to
  32. \ the vocabulary that they are defined in.
  33.  
  34. \ Define names to be imported from module - FROM modName IMPORT{ ... }
  35. \ ( -- modDefCfa )
  36. : From   modDef latest Name>  ;
  37.  
  38. \ imp def data consists of |mod0cfa|offs|
  39. \ code to execute for an import def
  40. 1 codefields
  41.     Do..  dup  4+ w@        \ @IMP
  42.         swap @ 4+ execute    \ exec 1cfa of MODULE def
  43.     ..End
  44.  
  45. 2drop
  46. Constant impCfa
  47.  
  48. \ build an import definition for the name at HERE
  49. : ,import { imp# modCfa -- }
  50.     here 1 and IF 0 c, THEN
  51.     createHdr -4 allot impCfa ,    \ create link, cfa
  52.     modCfa , imp# 4* 4+ w, latest modCfa 16 + ! ;    \ last import link
  53.  
  54. \ parse the export defs for module
  55. : Import{   { modCfa -- }   0
  56.     BEGIN  bl word  firstChr ascii } <>
  57.     WHILE  dup modCfa  ,import  1+    \ build import defs
  58.     REPEAT  modCfa  20 + w!  ;        \ save # of imports
  59.  
  60. 0 value  modStart    \ beginning addr of module during build
  61. 0 value  moduleCfa    \ cfa of module def during build
  62. 0 value  cleanMod    \ true if clean compile
  63.  
  64. \ clear object area of bitmap and create the indexed hdr
  65. : clearBits { addr len -- }    \ len is of overlay bytes
  66.     len bitsLen -> len  addr len  erase
  67.     ' bitMap addr ! len 8 - addr 6 + w! 1 addr 4+ w! ;
  68.  
  69. \ Build a bitmap containing relocation flags for all words in an application.
  70. : bldBits { base len \ hibase inc -- }
  71.     base len + -> hibase
  72.     base len 2* + 4+ -> bits
  73.     bits 4- len clearBits
  74.     len 0 DO
  75.         2 -> inc
  76.         base i+ w@  hiBase i+ w@ <>
  77.         IF i dup 1+ len >=
  78.             IF   1-
  79.             ELSE base i+ 2+ w@  hiBase i+ 2+ w@ <>
  80.                 IF 4 -> inc ELSE 1- THEN
  81.             THEN
  82.             2/ bits set: bitmap
  83.         THEN
  84.     inc +LOOP ;
  85.  
  86. \ build bitmap for overlay starting at word in stream
  87. : bldOvl { loBase hiBase \ len ^parms -- base totalLen }
  88.     hiBase loBase - -> len  loBase len bldBits
  89.     type# 185 ( module code size: ) len . ." bytes " cr
  90.     bits limit: [ bits ] + 4+ -> ^parms
  91.     len ^Parms w!  hiBase ^parms 2+ !            \ build parms area
  92.     hibase ^parms hiBase - 6 ( parmsLen ) +  ;    ( -- base len )
  93.  
  94. \ Save binary overlay for an application that was loaded twice
  95. : saveBin { loBase hiBase -- }
  96.     loBase hiBase bldovl    ( base len )
  97.     create: fFcb ?error 138
  98.     latest pfa lfa                \ find link field of first word in module
  99.     BEGIN @ pfa lfa dup @ hiBase < UNTIL
  100.     dup @ swap 0 over !            \ ( link addr )  zero out link field
  101.     2swap write: fFcb >R ! R> ?error 140
  102.     binType saveSig set: fFcb    \ set creator, type
  103.     close: fFcb drop ;
  104.  
  105. \ reserve space for export vectors and save modStart
  106. ( #exports -- )
  107. : ,Exports   here -> modStart  4* 4+ reserve ;
  108.  
  109. \ initialize the export vectors for module just compiled
  110. : !exports { modCfa \ thisImp -- }
  111.     modCfa 16 + @  -> thisImp    \ link to nfa of last import
  112.     BEGIN thisImp n>count sFind 0= ?error 143
  113.         drop dup nfa thisImp =
  114.         IF cr thisImp .name msg# 144 0 -> cleanMod
  115.         ELSE  dup nfa c@ thisImp c!    \ copy name flags into import definition
  116.             cfa thisImp name>
  117.             8+ w@ modStart + !    \ store export cfa
  118.         THEN    thisImp name> >link @ dup -> thisImp  Name> modCfa =
  119.     UNTIL ;        \ loop until back to module def
  120.  
  121. \ module builder - loads module source twice, relocates it, saves to disk
  122. \ use: mBuild "modFile"
  123. : Module { \ loMod hiMod mecho docState -- } docs -> docstate -docs
  124.     1 -> cleanMod  0 -> moduleCFA
  125.     " TASK" sCreate
  126.     $ 10000 here - 0 max allot    \ 64K compile boundry
  127.     new: loadFile setName: topFile
  128.     cr type# 176 ( Compiling module: ) getName: topFile type cr
  129.     Here -> loMod interpret: topFile    \ *** FIRST PASS
  130.     loMod @ latest or loMod !    \ mark last def (hi byte is flags)
  131.     cleanMod 0= ?error 145
  132.     moduleCfa >name n>count binName name: fFcb    \ set name of binary file
  133.     decho -> mecho -echo        \ preserve load echo flag
  134.     cr getName: fFcb type type# 177 ( Second pass…) cr
  135.     topFile 80 erase  setNamePtr: topfile    \ fresh fcb (for HFS compatability)
  136.     here -> hiMod interpret: topFile    \ *** SECOND PASS
  137.     hiMod @ latest or hiMod !    \ mark last def (hi byte is flags)
  138.     remove: loadfile
  139.     mecho -> decho                \ restore load echo flag
  140.     hiMod loMod - 0= ?error 146
  141.     loMod hiMod saveBin
  142.     ." Binary module " getName: fFcb type ."  successfully saved " cr
  143.     moduleCFA 12 +
  144.     dup @ -dup IF $ 0fffffff and killPtr THEN    \ purge old module from memory
  145.     dup @ $ 80000000 and swap !                 \ and remove pointer from cfa+12
  146.     " TASK" sFind  0 -> cleanMod
  147.     IF drop dup nfa -> dp lfa @ current ! THEN docState -> docs ;
  148.  
  149. \ begin a module source definition
  150. : :Module
  151.     @pfa cfa dup @ modCode <> ?error 147
  152.     dup -> moduleCfa cleanMod
  153.     0= ?error 164 cr    \ Use "Module" loader for modules
  154.     moduleCFA ?mlock ?error 188    \ module is locked
  155.     20 + w@ dup . type# 178 ( export entries ) cr
  156.     ,Exports   ;    \ build export vectors
  157.  
  158. \ Cause the module to remain locked after execution terminates
  159. : Locked 1 modStart c! ;
  160.  
  161. \ end a module source definition
  162. : ;Module
  163.     moduleCfa  dup 0= ?error 148
  164.     !exports  ;
  165.  
  166. \ if any of the imported words are defined in the module as immediate,
  167. \   you should move all of them to the last of the import list and
  168. \   then add n immediates to mark them as such.
  169. : immediates { num \ addr -- } latest -> addr
  170.     num 0 DO addr 64 toggle addr 1 traverse 1+ @ -> addr LOOP ;
  171.